home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Network Supervisor's Toolkit
/
Network Supervisor's Toolkit.iso
/
menus
/
mcmenu
/
textmenu.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-07-10
|
9KB
|
332 lines
UNIT TextMenu;
{ Oct 9 1991 Tony Bigras }
{
made wide max and better centering on large menus and 20 items nov 20
wider still with error traping of to wide feb 4 92
raised menu a little higher with more than 10 items
added alpha keying feb 8 92
1.001 bug fix in alpha keying feb 25 92
1.010 added 1 space white space on right side of menu txt
}
{$D-,S-}
INTERFACE
USES Crt,SysSup,Win;
CONST
mxmenustrlen=74;
mxmenuwidth=mxmenustrlen+7;
mxonmenu=21;
TYPE
txtctrltype = (normal,
reverse,
flashing);
menuctrltype= RECORD
sort: BOOLEAN;
wrap: BOOLEAN;
escape: BOOLEAN;
alphakey: BOOLEAN;
END;
keysettype = SET OF CHAR;
menustr = STRING[mxmenuwidth-4];
txtmenux = 0..76;
txtmenuy = 0..22;
txtmenunum = 0..mxonmenu; { 0 = esc }
modetype = (wipe,replace);
winrec = record
state: winstate;
buffer: POINTER;
END;
winrecptr = ^winrec;
menutype = RECORD
title: menustr;
item: ARRAY[1..mxonmenu] OF menustr;
numitem: txtmenunum;
x: txtmenux;
y: txtmenuy;
w: 1..mxmenuwidth;
oldselect: txtmenunum;
mode: modetype;
wn: winrecptr;
titlehelp:helpstr;
itemhelp: ARRAY[1..mxonmenu] OF helpstr;
ctrl: menuctrltype;
END;
frametype = (single,double);
VAR
txtmode: txtctrltype;
txtcur: txtctrltype;
menuactive: BOOLEAN; { set by caller to FALSE and set bye menu to TRUE
as soon as user starts moving on menu.
Intended to be read by concurent processes }
PROCEDURE getxy(VAR x,y: INTEGER);
PROCEDURE txtwr(x,y: INTEGER; str: STRING);
PROCEDURE txtmenuinit( VAR menu: menutype;
x: txtmenux; { if 0 centre }
y: txtmenuy); { if 0 centre }
PROCEDURE txtmenukill(VAR menu: menutype);
PROCEDURE openwindow(X1, Y1, X2, Y2: Byte;VAR w: winrecptr);
PROCEDURE closewindow(VAR w: winrecptr);
FUNCTION txtmenu( VAR menu: menutype): INTEGER;
{ 0 = escaped else selection }
IMPLEMENTATION
VAR
background,foreground: INTEGER;
txtupdownetc,updownetc,arrowetc: keysettype;
PROCEDURE getxy(VAR x,y: INTEGER);
BEGIN { getxy }
X:= wherex;
y:= wherey;
END; { getxy }
PROCEDURE txtwr(x,y: INTEGER; str: STRING);
BEGIN { txtwr }
gotoxy(x,y);
write(str);
gotoxy(x,y);
END; { txtwr }
PROCEDURE openwindow(x1, y1, x2, y2: BYTE;VAR w: winrecptr);
BEGIN
NEW(w);
WITH w^ DO
BEGIN
savewin(state);
window(x1, y1, x2, y2);
GETMEM(buffer, winsize);
readwin(buffer^);
END;
END;
PROCEDURE closewindow(VAR w: winrecptr);
BEGIN
WITH w^ DO
BEGIN
writewin(buffer^);
FREEMEM(buffer, winsize);
restorewin(state);
END;
DISPOSE(w);
END;
PROCEDURE showone(num: INTEGER; menuitem: STRING; reverse: BOOLEAN);
BEGIN { showone }
IF reverse= TRUE THEN
BEGIN
IF lastmode=mono THEN
BEGIN
background:=lightgray;
foreground:=black;
END
ELSE
BEGIN
background:=lightgray;
foreground:=blue;
END;
END
ELSE
BEGIN
IF lastmode=mono THEN
BEGIN
background:=black;
foreground:=white;
END
ELSE
BEGIN
background:=blue;
foreground:=white;
END;
END;
writestr(1,num+2,menuitem,foreground +background * 16);
END; { showone }
FUNCTION txtmenu( VAR menu: menutype): INTEGER;
VAR
i: INTEGER;
FUNCTION select: INTEGER;
VAR
key: CHAR;
tmenu: menutype;
i,j,cnt: INTEGER;
alpha: STRING[80];
nonalpha,matched: BOOLEAN;
BEGIN { select }
IF menu.ctrl.alphakey THEN
BEGIN
nonalpha:= TRUE;
tmenu:= menu;
FOR i:= 1 TO tmenu.numitem DO
BEGIN
FOR j:= 1 to LENGTH(tmenu.item[i]) DO
tmenu.item[i][j]:= upcase(tmenu.item[i][j]);
tmenu.item[i]:=COPY(tmenu.item[i],4,LENGTH(tmenu.item[i])-3);
{ strip pretty bar from front of item }
END;
END; { alphakey }
showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
REPEAT
key:= allowkey(txtupdownetc,-1);
menuactive:= TRUE; { somebody is moving around on menu }
CASE key OF
CHR(up):
BEGIN
nonalpha:= TRUE;
showone(menu.oldselect,menu.item[menu.oldselect],FALSE);
IF (menu.oldselect = 1) AND menu.ctrl.wrap THEN
menu.oldselect:= menu.numitem
ELSE
menu.oldselect:= max(1,menu.oldselect-1);
showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
END; { up }
CHR(down):
BEGIN
nonalpha:= TRUE;
showone(menu.oldselect,menu.item[menu.oldselect],FALSE);
IF (menu.oldselect = menu.numitem) AND menu.ctrl.wrap THEN
menu.oldselect:= 1
ELSE
menu.oldselect:= min(menu.numitem,menu.oldselect+1);
showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
END; { down }
CHR(32)..CHR(127):
BEGIN
showone(menu.oldselect,menu.item[menu.oldselect],FALSE);
IF nonalpha THEN
BEGIN
nonalpha:= FALSE;
alpha:= '';
END; { start alpha keying again as it was interupted }
alpha:= CONCAT(alpha,upcase(key));
matched:= FALSE;
cnt:= 0;
REPEAT
cnt:= cnt+1;
{ 1.001 matched from <>0 to =1 }
matched:= POS(alpha,COPY(tmenu.item[cnt],1,LENGTH(alpha)+1))=1;
UNTIL (matched OR (cnt > menu.numitem));
IF NOT matched THEN
BEGIN
nonalpha:= TRUE;
sound(300);
delay(100);
nosound;
END; { NOT matched }
IF matched THEN
menu.oldselect:=cnt;
showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
END; { alpha }
END; { CASE key }
IF menu.itemhelp[menu.oldselect]<>'' THEN
curhelp:=menu.itemhelp[menu.oldselect]
ELSE
curhelp:=menu.titlehelp;
UNTIL key IN [CHR(esc),CHR(return)];
IF key = CHR(esc) THEN
select:= 0
ELSE
select:= menu.oldselect
END; { select }
BEGIN { txtmenu }
{ 0 = escaped ELSE 1..x = selection }
txtmenu:= select;
END; { txtmenu }
PROCEDURE txtmenuinit( VAR menu: menutype;
x: txtmenux;
y: txtmenuy);
VAR
maxstrlen,i: INTEGER;
PROCEDURE showall;
VAR
i: INTEGER;
BEGIN { showall }
IF lastmode=mono THEN
BEGIN
splitbox(doubleframe,white + black * 16,3);
writestr(1,1,menu.title,white + black * 16);
END
ELSE
BEGIN
splitbox(doubleframe,yellow + blue * 16,3);
writestr(1,1,menu.title,white + blue * 16);
END;
FOR i:= 1 to menu.numitem DO
showone(i,menu.item[i],FALSE);
END; { showall }
BEGIN { txtmenuinit }
txtupdownetc:=updownetc;
IF menu.ctrl.escape THEN
txtupdownetc:=txtupdownetc+[CHR(esc)]; IF menu.ctrl.alphakey THEN
txtupdownetc:=txtupdownetc+[CHR(32)..CHR(127)]; FOR i:= 1 to menu.numitem DO
IF LENGTH(menu.item[i])>mxmenustrlen THEN
menu.item[i][0]:=CHR(mxmenustrlen);
IF LENGTH(menu.title)>mxmenustrlen THEN
menu.title[0]:=CHR(mxmenustrlen);
menu.w:=1;
{ 1.010 added space to menu items length }
FOR i:= 1 TO menu.numitem DO
menu.w:=max(LENGTH(menu.item[i])+1,menu.w);
IF (LENGTH(menu.title) MOD 2)=0 THEN
menu.title:= CONCAT(' ',menu.title);
menu.w:=max(LENGTH(menu.title),menu.w);
FOR i:= 1 TO menu.numitem DO
menu.item[i]:=
CONCAT(' │ ',menu.item[i],COPY(blanks,1,menu.w-LENGTH(menu.item[i])));
menu.title:=
CONCAT(COPY(blanks,1,((menu.w-LENGTH(menu.title)) DIV 2)+1),menu.title);
menu.w:= menu.w+4;
IF x<>0 THEN
menu.x:= x
ELSE
menu.x:=((80-menu.w) DIV 2) + 1;
IF y<>0 THEN
menu.y:= y
ELSE
menu.y:=max(1,(25-(menu.numitem+4)) DIV 2);
openwindow(menu.x,menu.y,menu.x+menu.w,menu.y+menu.numitem+3,menu.wn);
IF lastmode=mono THEN
fillwin(#32,lightgray+black*16)
ELSE
fillwin(#32,cyan + blue * 16);
showall;
END; { txtmenuinit }
PROCEDURE txtmenukill(VAR menu: menutype);
BEGIN
unframewin;
closewindow(menu.wn);
END;
BEGIN { TextMenu }
arrowetc:=
[CHR(esc),CHR(return),CHR(space),CHR(up),CHR(down),CHR(left),CHR(right)];
updownetc:=
[CHR(return),CHR(up),CHR(down)];
menuactive:= FALSE;
END. { TextMenu }